{ Image Macros for intensity calculations on Photometrics CCD images } {Globals} var {16 to 8 conversion info} ymin, ymax, {pid numbers for images} SumArray, XArray, YArray, SegNArray, customLUTpid, smoothPid, raw16Pid, rawWidth, rawHeight, proc16Pid, proc8Pid, procXmin, procXmax, temp16Pid, flagPid, mask1Pid, maskWidth, maskHeight, seg8aPid, seg8bPid, bkgSegPid, dark16Pid, unif16Pid, uscr16Pid, {segmentation} segN, svL,svT,svW,svH, {save ROI values} hide8Done, : integer; {initialize/restore globals} begin requiresUser('Pixel16u',2); requiresUser('GetPutPixel',1); requiresUser('timer',1); requiresUser('utilities',1); requiresUser('markup',1); ymin := getMemo('ymin'); ymax := getMemo('ymax'); {pid numbers} SumArray := getMemo('SumArray'); XArray := getMemo('XArray'); YArray := getMemo('YArray'); SegNArray := getMemo('SegNArray'); customLUTpid := getMemo('customLUTpid'); smoothPid := getMemo('smoothPid'); raw16Pid := getMemo('raw16Pid'); rawWidth := getMemo('rawWidth'); rawHeight := getMemo('rawHeight'); proc16Pid := getMemo('proc16Pid'); temp16Pid := getMemo('temp16Pid'); flagPid := getMemo('flagPid'); mask1Pid := getMemo('mask1Pid'); maskWidth := getMemo('maskWidth'); maskHeight := getMemo('maskHeight'); proc8Pid := getMemo('proc8Pid'); procXmin := getMemo('procXmin'); procXmax := getMemo('procXmax'); seg8aPid := getMemo('seg8aPid'); seg8bPid := getMemo('seg8bPid'); bkgSegPid := getMemo('bkgSegPid'); dark16Pid := getMemo('dark16Pid'); unif16Pid := getMemo('unif16Pid'); uscr16Pid := getMemo('uscr16Pid'); segN := getMemo('segN'); if segN < 1 then segN := 1; if segN > 250 then segN := 250; setMemo('segN',segN); svL := getMemo('svL'); svT := getMemo('svT'); svW := getMemo('svW'); svH := getMemo('svH'); SetBackgroundColor(0); SetForeGroundColor(255); end; procedure disposePic(p: integer); begin if pidExists(p) then begin selectPic(p); dispose; end; end; procedure kill16Roi; var wasPid: integer; begin wasPid := pidNumber; choosePic(raw16Pid); killRoi; choosePic(proc16Pid); killRoi; choosePic(temp16Pid); killRoi; choosePic(dark16Pid); killRoi; choosePic(unif16Pid); killRoi; if PidExists(uscr16Pid) then begin choosePic(uscr16Pid); killRoi; end; choosePic(wasPid); end; procedure copyFromTo(fromPid,toPid: integer); var wasPid: integer; begin wasPid := pidNumber; choosePic(fromPid); selectAll; copy; killRoi; choosePic(toPid); selectAll; paste; killRoi; choosePic(wasPid); end; procedure createSmoothKernel; var x, y: integer; sum: real; begin RequiresUser('getputpixel', 1); disposePic(smoothPid); SaveState; SetNewSize(kw * 4, kh + 1); MakeNewWindow('kernel ', kx : 0, 'x ', ky : 0, 'y ', kw : 0, 'w ', kh : 0, 'h'); smoothPid := pidNumber; SetMemo('smoothPid', smoothPid); RestoreState; putPixel(0, 0, kx); putPixel(1, 0, ky); putPixel(2, 0, kw); putPixel(3, 0, kh); sum := 0.0; for x := -kx to kw - kx - 1 do begin for y := -ky to kh - ky - 1 do begin sum := sum + exp(-sqrt(sqr(x) + sqr(y))); end; end; sum := 32000.0 / sum; {nearly maximum before overflow on 65535 pixel} for x := -kx to kw - kx - 1 do begin for y := -ky to kh - ky - 1 do begin putPixel32s(smoothPid, x + kx, y + ky + 1, sum * exp(-sqrt(sqr(x) + sqr(y)))); end; end; sum := 0.0; for x := -kx to kw - kx - 1 do begin for y := -ky to kh - ky - 1 do begin sum := sum + getPixel32s(smoothPid, x + kx, y + ky + 1); end; end; showmessage('kernel sum = ', sum); SelectPic(smoothPid); MakeRoi(0, 1, kw * 4, kh); end; procedure stdSmooth; var kx, ky, kw, kh: integer; begin kx := 1; ky := 1; kw := 3; kh := 3; createSmoothKernel; end; macro 'Create standard 3x3 smoothing kernel'; begin stdSmooth; end; macro 'Create arbitrary smoothing kernel'; var kx, ky, kw, kh: integer; begin kw := GetNumber('kernel width',5); kh := GetNumber('kernel height',5); kx := GetNumber('kernel x center',kw div 2); ky := GetNumber('kernel y center',kh div 2); createSmoothKernel; end; procedure setMaskSize; var kx, ky, kw, kh: integer; front: integer; begin front := pidNumber; {find size of smoothing kernel} ChoosePic(smoothPid); kx := getPixel(0, 0); ky := getPixel(1, 0); kw := getPixel(2, 0); kh := getPixel(3, 0); MakeRoi(0, 1, kw * 4, kh); maskWidth := rawWidth + kw - 1; maskHeight := rawHeight + kh - 1; SetMemo('maskWidth',maskWidth); SetMemo('maskHeight',maskHeight); ChoosePic(front); end; procedure forceROIWithin; var left, top, rwidth, rheight{, iwidth, iheight}: integer; begin GetRoi(left,top,rwidth,rheight); if rwidth = 0 then selectAll; {this fixes most cases} { GetPicSize(iwidth,iheight); GetRoi(left,top,rwidth,rheight); if (left < 0) or (top < 0) or (left + rwidth > iwidth) or (top + rheight > iheight) then begin putmessage('ROI must not extend outside image'); exit; ...make ROI doesn't hack it if ROI wasn't rectangular... if left < 0 then begin rwidth := rwidth + left; left := 0; end; if top < 0 then begin rheight := rheight + top; top := 0; end; if left + rwidth > iwidth then begin rwidth := iwidth - left; end; if top + rheight > iheight then begin rheight := iheight - top; end; makeroi(left,top,rwidth,rheight); end; } end; procedure forceUncalib; begin SelectPic(proc8Pid); if Calibrated then begin selectAll; copy; disposePic(proc8Pid); SaveState; setNewSize(rawWidth, rawHeight); makeNewWindow('Processed 8 bit image'); proc8Pid := pidNumber; setMemo('proc8Pid',proc8Pid); RestoreState; Paste; KillRoi; end; SelectPic(proc8Pid); end; {adjust xmin/xmax using mean ± stdev} procedure enhanceStdev; var mean, sigma, coef: real; begin Kill16ROI; choosePic(proc8Pid); forceROIWithin; forceUncalib; KillROI; coef := (procXmax - procXmin + 1) / (ymax - ymin + 1); {might not work if coef < 0???} linLUT16uto8(customLUTPid, procXmin, procXmax, ymin, ymax); Cnvrt16uto8(proc16Pid, customLUTPid, proc8Pid); RestoreRoi; {take mean & stdev over ROI of 8 bit image} SetOptions('Area,Mean,Std. Dev.,User1,User2'); Measure; mean := (rmean[rCount]-ymin) * coef + procXmin + coef / 2; sigma := rStdDev[rCount] * coef + coef / 2; {serious round off errors happen when sigma < coef } {so that the mean is not known well enough, } {image comes out white or black} if sigma < coef then sigma := coef; SetCounter(rCount-1); procXmin := mean - 2*sigma; {this needs to be an adjustable parameter} procXmax := mean + 4*sigma; SetMemo('procXmin',procXmin); SetMemo('procXmax',procXmax); end; {adjust xmin/xmax using mean and maximum} {revised: use mean of inner ROI and then mean of outer ROI} procedure adjMeanMax; var mean, sigma, coef: real; begin Kill16ROI; choosePic(proc8Pid); forceROIWithin; forceUncalib; KillROI; coef := (procXmax - procXmin + 1) / (ymax - ymin + 1); {might not work if coef < 0???} linLUT16uto8(customLUTPid, procXmin, procXmax, ymin, ymax); Cnvrt16uto8(proc16Pid, customLUTPid, proc8Pid); RestoreRoi; {take mean & stdev over ROI of 8 bit image} SetOptions('Area,Mean,Std. Dev.,User1,User2'); Measure; InsetRoi(-20); Measure; mean := (rmean[rCount]-ymin) * coef + procXmin + coef / 2; sigma := (rmean[rCount-1]+2*rStdDev[rCount-1]-ymin) * coef + procXmin + coef / 2; sigma := (sigma - mean) / 4; if sigma < coef then sigma := coef; SetCounter(rCount-1); procXmin := mean - 0.75*sigma; {this needs to be an adjustable parameter} procXmax := mean + 4*sigma; SetMemo('procXmin',procXmin); SetMemo('procXmax',procXmax); end; {display 16 bit data into the 8 bit image using specified xmin/xmax} procedure show16; var lower, upper: integer; begin hide8Done := false; Kill16ROI; choosePic(proc8Pid); forceROIWithin; KillROI; linLUT16uto8(customLUTPid, procXmin, procXmax, ymin, ymax); Cnvrt16uto8(proc16Pid, customLUTPid, proc8Pid); RestoreRoi; SelectPic(proc8Pid); GetThresholds(lower, upper); ShowMessage(procXmin,' min\',procXmax,' max\',lower,' lower\',upper,' upper\'); end; procedure swapTemp16; var temp: integer; begin temp := temp16Pid; temp16Pid := proc16Pid; proc16Pid := temp; SetMemo('temp16Pid',temp16Pid); SetMemo('proc16Pid',proc16Pid); temp := pidNumber; choosePic(proc16Pid); SetPicName('Processed 16 bit image'); killROI; choosePic(temp16Pid); SetPicName('Temporary 16 bit image'); killROI; choosePic(temp); end; procedure hide8image(msg: string); var width, height: integer; begin SelectPic(proc8Pid); if not hide8Done then begin setDensitySlice(0,0); setforegroundcolor(255); setbackgroundcolor(0); selectAll; clear; getPicSize(width, height); moveto(width div 3, height div 3); hide8Done := true; end; writeln(msg); end; procedure press8ToDisplay; begin if not hide8Done then hide8image(''); SelectPic(proc8Pid); writeln('Press 8 to display image'); end; procedure checkSize(p,w,h: integer); var width, height, front: integer; begin if pidExists(p) then begin front := pidNumber; choosePic(p); getPicSize(width, height); choosePic(front); if (width <> w) or (height <> h) then disposePic(p); end; end; procedure LUT(x, r, g, b); begin RedLut[x] := r; GreenLut[x] := g; BlueLut[x] := b; end; procedure segLUT; begin ResetGrayMap; LUT(1,255,0,0); LUT(2,0,255,0); LUT(3,0,0,255); LUT(4,255,255,0); LUT(5,0,255,255); LUT(6,255,0,255); LUT(7,255,128,128); LUT(8,128,255,128); LUT(9,128,128,255); UpdateLUT; end; procedure makeArray(name: string); begin if not pidExists(getMemo(name)) then begin SetNewSize(32,32); MakeNewWindow(name); SetMemo(name,pidNumber); end; end; procedure clearPic(pid: integer); var wasPid: integer; begin wasPid := pidNumber; choosePic(pid); selectAll; setBackgroundColor(0); clear; killRoi; choosePic(wasPid); end; {if the scratch windows are wrong size or missing, create them} procedure makeScratchIfNeed; var width, height: integer; begin SelectPic(pidNumber); saveState; makeArray('SumArray'); makeArray('XArray'); makeArray('YArray'); makeArray('SegNArray'); SumArray := getMemo('SumArray'); XArray := getMemo('XArray'); YArray := getMemo('YArray'); SegNArray := getMemo('SegNArray'); if (ymin = 0) and (ymax = 0) then begin ymin := 1; ymax := 254; end; if (ymin < 0) or (ymin > 255) then ymin := 1; if (ymax < 0) or (ymax > 255) then ymax := 254; if ymin > ymax then begin ymin := 1; ymax := 254; end; SetMemo('ymin',ymin); SetMemo('ymax',ymax); if not pidExists(customlutPid) then begin setNewSize(256,256); makeNewWindow('custom LUT'); SelectAll; KillRoi; customLUTpid := pidNumber; SetMemo('customLUTpid',customLUTpid); end; linLUT16uto8(customLUTpid, 0, 65535, ymin, ymax); if not pidExists(smoothPid) then begin stdSmooth; end; if not pidExists(raw16Pid) then begin putMessage('makeScratch no raw16'); exit; end; choosePic(raw16Pid); getPicSize(width, height); rawWidth := (width div 4) * 2; rawHeight := height; setMemo('rawWidth',rawWidth); setMemo('rawHeight',rawHeight); if rawWidth * 2 <> width then begin putMessage('makeScratch raw width not multiple of 4'); exit; end; checkSize(proc16Pid,rawWidth * 2,rawHeight); if not pidExists(proc16Pid) then begin setNewSize(rawWidth * 2, rawHeight); makeNewWindow('Processed 16 bit image'); SelectAll; KillRoi; proc16Pid := pidNumber; SetMemo('proc16Pid',proc16Pid); end; checkSize(temp16Pid,rawWidth * 2,rawHeight); if not pidExists(temp16Pid) then begin setNewSize(rawWidth * 2, rawHeight); makeNewWindow('Temporary 16 bit image'); SelectAll; KillRoi; temp16Pid := pidNumber; SetMemo('temp16Pid',temp16Pid); end; checkSize(dark16Pid,rawWidth * 2,rawHeight); if not pidExists(dark16Pid) then begin setNewSize(rawWidth * 2, rawHeight); makeNewWindow('Dark 16 bit image'); SelectAll; KillRoi; dark16Pid := pidNumber; SetMemo('dark16Pid',dark16Pid); end; checkSize(unif16Pid,rawWidth * 2,rawHeight); if not pidExists(unif16Pid) then begin setNewSize(rawWidth * 2, rawHeight); makeNewWindow('Uniform 16 bit image'); SelectAll; KillRoi; unif16Pid := pidNumber; SetMemo('unif16Pid',unif16Pid); end; checkSize(uscr16Pid,rawWidth * 2,rawHeight); if not pidExists(uscr16Pid) then begin setNewSize(rawWidth * 2, rawHeight); makeNewWindow('Uniform Scratch 16 bit image'); SelectAll; KillRoi; uscr16Pid := pidNumber; SetMemo('uscr16Pid',uscr16Pid); end; checkSize(flagPid,rawWidth,rawHeight); if not pidExists(flagPid) then begin setNewSize(rawWidth, rawHeight); makeNewWindow('smoothing flag image'); SelectAll; KillRoi; flagPid := pidNumber; SetMemo('flagPid',flagPid); end; setMaskSize; checkSize(mask1Pid,maskWidth,maskHeight); if not pidExists(mask1Pid) then begin setNewSize(maskWidth, maskHeight); makeNewWindow('smoothing mask image 1'); SelectAll; KillRoi; mask1Pid := pidNumber; SetMemo('mask1Pid',mask1Pid); end; checkSize(proc8Pid,rawWidth,rawHeight); if not pidExists(proc8Pid) then begin setNewSize(rawWidth, rawHeight); makeNewWindow('Processed 8 bit image'); SelectAll; KillRoi; proc8Pid := pidNumber; setMemo('proc8Pid',proc8Pid); end; checkSize(seg8aPid,rawWidth,rawHeight); if not pidExists(seg8aPid) then begin setNewSize(rawWidth, rawHeight); makeNewWindow('Segments A'); SegLUT; SelectAll; KillRoi; seg8aPid := pidNumber; setMemo('seg8aPid',seg8aPid); end; checkSize(seg8bPid,rawWidth,rawHeight); if not pidExists(seg8bPid) then begin setNewSize(rawWidth, rawHeight); SelectPic(seg8aPid); makeNewWindow('Segments B'); SegLUT; SelectAll; KillRoi; seg8bPid := pidNumber; setMemo('seg8bPid',seg8bPid); end; checkSize(bkgSegPid,rawWidth,rawHeight); if not pidExists(bkgSegPid) then begin setNewSize(rawWidth, rawHeight); makeNewWindow('Background Segments'); SelectAll; KillRoi; bkgSegPid := pidNumber; setMemo('bkgSegPid',bkgSegPid); end; restoreState; end; macro 'seg LUT'; begin segLUT; end; { import arbitrary IPLab image: if (getpixel(0,0) <> ord('2')) or (getpixel(1,0) <> ord('.')) or (getpixel(2,0) <> ord('3')) or (getpixel(3,0) <> ord('a')) or (getpixel(4,0) <> 0) or (getpixel(5,0) <> 1) {short int} then else width := ((getpixel(6,0) * 256 + getpixel(7,0)) * 256 + getpixel(8,0)) * 256 + getpixel(9,0); height := ((getpixel(10,0) * 256 + getpixel(11,0)) * 256 + getpixel(12,0)) * 256 + getpixel(13,0); offset := 2120; } {if there is no raw data image, import one} procedure importIfNeed; var origPid: integer; rawMin, rawMax: integer; begin origPid := 0; if not pidExists(raw16Pid) then begin SaveState; SetImport('8-bits,Custom'); SetCustom(2634,1034,2120); Import(''); origPid := pidNumber; {MakeNewWindow will not make odd width windows.} {Therefore, 16 bit images must be even # pixels wide} {or width multiple of 4} SetNewSize(2632,1031); MakeRoi(2, 3, 2632,1031); Copy; MakeNewWindow(GetPicName,'trimmed'); raw16Pid := pidNumber; SetMemo('raw16Pid',raw16Pid); Paste; KillROI; disposePic(origPid); RestoreState; makeScratchIfNeed; minmax16u(raw16Pid, rawMin, rawMax); if rawMax > 4095 then begin divk16u(raw16Pid,temp16Pid,4096); mpyK16u(temp16Pid,temp16Pid,4096); sub16u(raw16Pid,temp16Pid,raw16Pid); minmax16u(raw16Pid, rawMin, rawMax); end; showmessage(rawMin,' rawMin\', rawMax,' rawMax'); SelectPic(proc8Pid); copyFromTo(raw16Pid, proc16Pid); end; makeScratchIfNeed; SelectPic(proc8Pid); end; macro '[1] copy proc to dark image'; begin SelectPic(proc8Pid); choosePic(proc16Pid); selectAll; copy; killRoi; choosePic(dark16Pid); selectAll; paste; killRoi; SelectPic(proc8Pid); end; macro '[2] copy proc to uniform image'; begin SelectPic(proc8Pid); choosePic(proc16Pid); selectAll; copy; killRoi; choosePic(unif16Pid); selectAll; paste; killRoi; SelectPic(proc8Pid); end; procedure doSubDark; begin hide8Image('subtract dark'); kill16ROI; sub16u(proc16Pid,dark16Pid,temp16Pid); swapTemp16; press8ToDisplay; end; macro '[d] subtract dark image'; begin doSubDark end; macro '[f] flat field -- divide by uniform image'; begin hide8Image('divide by uniform'); kill16ROI; ratio16u(proc16Pid,unif16Pid,temp16Pid,16384); swapTemp16; press8ToDisplay; end; macro 'Remove 32768'; begin hide8Image('Remove 32768'); divk16u(proc16Pid,temp16Pid,32768); mpyK16u(temp16Pid,temp16Pid,32768); sub16u(proc16Pid,temp16Pid,proc16Pid); press8ToDisplay; end; macro '[a] start over from raw image'; begin hide8Image('raw data'); importIfNeed; copyFromTo(raw16Pid, proc16Pid); press8ToDisplay; end; macro '[z] undo last 16 bit transform'; begin hide8Image('undo'); swapTemp16; press8ToDisplay; end; procedure doReduceNoise; begin hide8Image('reduce noise'); {actually only need to copy the border} choosePic(proc16Pid); selectAll; copy; killRoi; choosePic(temp16Pid); selectAll; paste; {end copy} choosePic(proc16Pid); makeRoi(2,1,(rawWidth-2)*2,rawHeight-2); choosePic(temp16Pid); makeRoi(2,1,(rawWidth-2)*2,rawHeight-2); median16u(proc16Pid,temp16Pid); kill16ROI; swapTemp16; press8ToDisplay; end; macro '[r]reduce noise'; begin doReduceNoise; end; procedure doRadMed(radius: real); var r: integer; begin hide8Image(concat('radial median filter',radius)); r := round(radius + 0.5); {actually only need to copy the border} choosePic(proc16Pid); selectAll; copy; killRoi; choosePic(temp16Pid); selectAll; paste; killRoi; {end copy} choosePic(proc16Pid); makeRoi(2*r,r,(rawWidth-2*r)*2,rawHeight-2*r); choosePic(temp16Pid); makeRoi(2*r,r,(rawWidth-2*r)*2,rawHeight-2*r); radMedian16u(proc16Pid,temp16Pid,radius); kill16ROI; swapTemp16; press8ToDisplay; end; procedure doMinSpat; begin hide8Image('min spatial'); choosePic(proc16Pid); makeRoi(2,1,(rawWidth-2)*2,rawHeight-2); choosePic(temp16Pid); makeRoi(2,1,(rawWidth-2)*2,rawHeight-2); minspat16u(proc16Pid,temp16Pid); kill16ROI; swapTemp16; press8ToDisplay; end; macro '[m]min spatial filter'; begin doMinSpat; end; macro '[4] Make standard uniform image'; begin hide8Image('raw data'); kill16Roi; copyFromTo(raw16Pid, proc16Pid); doSubDark; doReduceNoise; doMinSpat; hide8Image('save as Uniform Scratch'); copyFromTo(proc16Pid, uscr16Pid); copyFromTo(proc16Pid, unif16Pid); doRadMed(30); hide8Image('uniform = minimum of uniform, processed'); sml16u(proc16Pid, unif16Pid, unif16Pid); hide8Image('go back to uniform scratch'); copyFromTo(uscr16Pid, proc16Pid); doRadMed(10); hide8Image('uniform = minimum of uniform, processed'); sml16u(proc16Pid, unif16Pid, unif16Pid); hide8Image('go back to uniform scratch'); copyFromTo(uscr16Pid, proc16Pid); doRadMed(60); hide8Image('processed = minimum of uniform, processed'); sml16u(proc16Pid, unif16Pid, proc16Pid); doRadMed(50); doRadMed(5); doMinSpat; hide8Image('copy processed to uniform'); copyFromTo(proc16Pid, unif16Pid); press8ToDisplay; end; macro '[s] smooth'; var kx, ky, kw, kh: integer; begin hide8Image('smooth'); SetBackgroundColor(0); kill16Roi; ChoosePic(smoothPid); kx := getPixel(0, 0); ky := getPixel(1, 0); kw := getPixel(2, 0); kh := getPixel(3, 0); MakeRoi(0, 1, kw * 4, kh); ChoosePic(flagPid); SelectAll; Clear; KillRoi; ChoosePic(mask1Pid); MakeRoi(kx, ky, rawWidth, rawHeight); Clear; SetForegroundColor(255); MakeRoi(0, 0, kx, rawHeight + kh); Fill; MakeRoi(kx + rawWidth, 0, kw - kx - 1, rawHeight + kh); Fill; MakeRoi(kx, 0, rawWidth, ky); Fill; MakeRoi(kx, ky + rawHeight, rawWidth, kh - ky - 1); Fill; {Mask image must have an ROI same size as image and} {with borders matching kernel, thus:} MakeRoi(kx, ky, rawWidth, rawHeight); Convolve16u(flagPid, proc16Pid, smoothPid, kx, ky, mask1Pid, temp16Pid); swapTemp16; press8ToDisplay; end; macro '[3]Load a new image'; begin if pidExists(proc8Pid) then hide8Image('loading new image'); disposePic(raw16Pid); importIfNeed; minmax16u(proc16Pid, procXmin, procXmax); SetMemo('procXmin',procXmin); SetMemo('procXmax',procXmax); press8ToDisplay; end; macro 'Front 16 bit image is raw data'; begin raw16Pid := pidNumber; SetMemo('raw16Pid',raw16Pid); SelectPic(raw16Pid); makeScratchIfNeed; hide8Image('raw data'); copyFromTo(raw16Pid, proc16Pid); press8ToDisplay; end; procedure mySaveROI; begin getRoi(svL,svT,svW,svH); makeRoi(svL,svT,svW,svH); setMemo('svL',svL); setMemo('svT',svT); setMemo('svW',svW); setMemo('svH',svH); end; macro '[7]Convert to 8 bit with mean max scaling'; begin importIfNeed; minmax16u(proc16Pid, procXmin, procXmax); SetMemo('procXmin',procXmin); SetMemo('procXmax',procXmax); show16; adjMeanMax; show16; mySaveROI; Copy; end; macro '[*]Convert to 8 bit with min max scaling'; begin importIfNeed; minmax16u(proc16Pid, procXmin, procXmax); SetMemo('procXmin',procXmin); SetMemo('procXmax',procXmax); show16; end; macro '[8]Convert to 8 bit with mean ± stdev scaling'; begin importIfNeed; minmax16u(proc16Pid, procXmin, procXmax); SetMemo('procXmin',procXmin); SetMemo('procXmax',procXmax); show16; enhanceStdev; show16; end; macro '[¥]Enhance ROI of 8 bit image'; begin importIfNeed; enhanceStdev; show16; end; macro '[9]- xmin'; begin importIfNeed; procXmin := round(procXmin - 0.1*(procXmax - procXmin) - 1); if procXmin > procXmax then procXmax := procXmin + 1; SetMemo('procXmin',procXmin); show16; end; macro '[»]+ xmin'; begin importIfNeed; procXmin := round(procXmin + 0.1*(procXmax - procXmin) + 1); if procXmin > procXmax then procXmax := procXmin + 1; SetMemo('procXmin',procXmin); show16; end; macro '[0]- xmax'; begin importIfNeed; procXmax := round(procXmax - 0.1*(procXmax - procXmin) - 1); if procXmax < procXmin then procXmin := procXmax - 1; SetMemo('procXmin',procXmin); show16; end; macro '[¼]+ xmax'; begin importIfNeed; procXmax := round(procXmax + 0.1*(procXmax - procXmin) + 1); if procXmin > procXmax then procXmin := procXmax - 1; SetMemo('procXmin',procXmin); show16; end; macro '[g] Show processed 8 bit image'; begin SelectPic(proc8Pid); end; macro '[©] Reconvert 8 bit image'; begin Show16; end; procedure adjustsegN(offset: integer); var wrap: integer; begin if offset < 0 then wrap := 250 else wrap := 1; segN := segN + offset; if segN > 250 then segN := wrap; if segN < 1 then segN := wrap; setMemo('segN',segN); end; macro '[h] show seg A'; begin adjustsegN(0); SelectPic(seg8aPid); ShowMessage(segN,' Segment\'); end; procedure appendROI; var fg, lower,upper: integer; begin fg := pidNumber; GetThreshold(lower,upper); SetDensitySlice(0,0); KillRoi; RestoreRoi; Clear; ChoosePic(seg8aPid); SetBackgroundColor(0); SetForegroundColor(segN); RestoreRoi; fill; Measure; PutPixVec32s(XArray,segN,rX[rCount]*100); PutPixVec32s(YArray,segN,rY[rCount]*100); PutPixVec32s(SegNArray,segN,segN); setCounter(rCount-1); SetForegroundColor(255); SelectPic(fg); ShowMessage(segN,' Segment\',lower,'lower\',upper,'upper\'); if upper = 255 then SetThreshold(lower) else SetDensitySlice(lower,upper); end; macro '[n]ROI is Next segment'; begin adjustsegN(1); appendROI; end; macro '[j] ROI is a Junk segment'; begin adjustsegN(1); appendROI; PutPixVec32s(SegNArray,segN,0); end; { procedure eraseSegment; var fg, lower,upper: integer; begin fg := pidNumber; GetThreshold(lower,upper); SetDensitySlice(0,0); ChoosePic(seg8aPid); ChangeValues(segN,segN,0); PutPixVec32s(XArray,segN,0); PutPixVec32s(YArray,segN,0); PutPixVec32s(SegNArray,segN,0); SelectPic(fg); ShowMessage(segN,' Segment\',lower,'lower\',upper,'upper\'); if upper = 255 then SetThreshold(lower) else SetDensitySlice(lower,upper); end; macro '[b] erase seg'; begin eraseSegment; end; } macro '[F1]set up Background'; begin SelectPic(Proc8Pid); SelectAll; Copy; KillRoi; SelectPic(BkgSegPid); SelectAll; Paste; KillRoi; Measure; SetDensitySlice(rMean[rCount]-rStdDev[rCount]/2, rMean[rCount]+rStdDev[rCount]/2); SetCounter(rCount-1); end; macro '[F2]Clear segs'; var lower: integer; begin copyFromTo(seg8aPid, seg8bPid); clearPic(seg8aPid); SelectPic(proc8Pid); segN := 250; SetMemo('segN',segN); clearPic(XArray); clearPic(YArray); clearPic(SegNArray); Show16; killRoi; measure; lower := rMean[rCount]+2*rStdDev[rCount]; if lower > 250 then lower := 250; SetDensitySlice(lower,255); setCounter(rCount-1); end; macro '[F3]dilate segs A onto B'; var r: integer; width,height: integer; begin SelectPic(seg8aPid); r := 3; r := GetNumber('dilation radius',r); SelectAll; Copy; InsetRoi(r+1); choosePic(seg8bPid); SelectAll; Paste; InsetRoi(r+1); Dilate8Circular(seg8aPid, seg8bPid, r); choosePic(seg8aPid); KillRoi; SelectPic(seg8bPid); KillRoi; end; macro '[F4]copy segs B onto A'; begin copyFromTo(seg8bPid, seg8aPid); SelectPic(seg8aPid); end; macro '[F5]intensities using segments A'; var i, j, k, r, x, area, sum: integer; avgBkg, total: real; begin showmessage('finding neighborhood of segments'); SetPrecision(4,13); SelectPic(seg8aPid); SelectAll; Copy; KillRoi; r := 5; ChoosePic(flagPid); SelectAll; Paste; ChangeValues(1,255,1); Copy; InsetRoi(r+1); ChoosePic(seg8bPid); SelectAll; Paste; InsetRoi(r+1); Dilate8Circular(flagPid, seg8bPid, r); ChoosePic(seg8bPid); SelectAll; Copy; r := 10; ChoosePic(flagPid); SelectAll; Paste; InsetRoi(r+1); ChoosePic(seg8bPid); SelectAll; Invert; Copy; Invert; InsetRoi(r+1); Dilate8Circular(seg8bPid, flagPid, r); ChoosePic(flagPid); SelectAll; Paste; DoAnd; ChangeValues(1,255,255); Showmessage('finding background pixels'); ChoosePic(BkgSegPid); SelectAll; Copy; ChoosePic(flagPid); SelectAll; Paste; DoAnd; SelectAll; Copy; ChoosePic(Seg8bPid); Paste; ChoosePic(Seg8aPid); SelectAll; Copy; ChoosePic(Seg8bPid); Paste; DoOr; ShowMessage('calculating'); SaveState; clearPic(SumArray); Sum16uMark(proc16Pid,Seg8bPid,SumArray); {also need standard deviation, min, max} SetOptions('area,user1,user2,Min/Max,X-Y Center,Angle'); ChoosePic(Seg8bPid); KillRoi; Measure; {get area from histogram array} SetCounter(rCount-1); i := 0; if histogram[255] = 0 then begin putMessage('no background'); exit; end; avgBkg := GetPixVec32s(SumArray,255) / histogram[255]; total := 0; for k := 1 to 255 do begin sum := GetPixVec32s(SumArray,k); area := histogram[k]; if area <> 0 then begin i := i + 1; SetCounter(i); rMin[i] := k; rMax[i] := GetPixVec32s(SegNArray,k); rArea[i] := area; rUser1[i] := sum; if rMax[i] <> 0 then begin rAngle[i] := sum - area*AvgBkg; total := total + rAngle[i]; end else begin rAngle[i] := 0; end; rX[i] := GetPixVec32s(XArray,k)/100; rY[i] := GetPixVec32s(YArray,k)/100; end; end; SetCounter(i); if total = 0 then total := 1; for k := 1 to i do begin rUser2[k] := rAngle[k] / total; end; SetUser1Label('sum'); SetUser2Label('s-a*b/t'); ShowResults; RestoreState; SelectPic(Seg8bPid); ShowResults; UpdateResults; Copy; end; macro '[F6] Save ROI and copy'; begin mySaveROI; copy; end; macro '[F7] Restore saved ROI and copy'; begin makeRoi(svL,svT,svW,svH); copy; end; macro '[F12] Enable Density Slice'; begin SetDensitySlice(255,255); end; macro '[F13]radial median filter'; var radius: real; begin radius := getNumber('radius',10); doRadMed(radius); end; macro '[F14] Uniform = smaller of Uniform and processed'; begin kill16Roi; selectPic(proc8Pid); sml16u(proc16Pid, unif16Pid, unif16Pid); end; macro '[F8] Show results length only and copy'; begin SetOptions('length'); ShowResults; Copy; end;